Attribute VB_Name = "ModuleUtil"
Option Explicit

Public Const cEpsilon As Double = 0.0000001    ' pour les comparaisons de nb virgule


Function RandGauss(Mean, Sd) As Double

'from Numerical Recipes in C, second edition, page 289
'returns a random number from Gaussian distribution with mean and SD specified
Static NextRnd As Double
Static RndWaiting As Boolean
Static Randomized As Boolean

Dim fac, rsq, v1, v2, RandStd As Double

If Not (Randomized) Then
  Randomize
   Randomized = True
End If

If Not (RndWaiting) Then
  Do
    v1 = 2# * Rnd() - 1#
    v2 = 2# * Rnd() - 1#
    rsq = v1 * v1 + v2 * v2
    Loop Until rsq <= 1#
    fac = Sqr(-2# * Log(rsq) / rsq) 'natural log
    NextRnd = v1 * fac
    RndWaiting = True
    RandStd = v2 * fac
  Else
    RndWaiting = False
    RandStd = NextRnd
  End If
'RandStd has mean zero and SD=1.
RandGauss = (RandStd * Sd) + Mean

End Function


Sub Note_Au_Hasard()
Attribute Note_Au_Hasard.VB_ProcData.VB_Invoke_Func = "H\n14"
   Dim note As Double
   note = Round(RandGauss(8.5, 2), 1)
   
   If note > 9.9 Then
     note = 9.9
   End If
   
   If note >= 7 Then
      note = note + 1 + Round(Rnd() * 4, 0)
   End If
   ActiveCell = note
   ActiveCell.Offset(1, 0).Select
End Sub


Sub CreerSheet(titre As String, avertir As Boolean)
   SupprimerSheet titre:=titre, avertir:=avertir
   Sheets.Add
   ActiveSheet.Name = titre
End Sub


Sub SupprimerSheet(titre As String, avertir As Boolean)

    Dim shAct As Worksheet
    Dim rMsgBox As Integer
    
    For Each shAct In ActiveWorkbook.Worksheets
        If shAct.Name = titre Then
            If avertir Then
                rMsgBox = MsgBox(msgContinue, vbYesNo + vbQuestion, nomAppli)
            Else
                rMsgBox = vbYes
            End If
            If rMsgBox = vbYes Then
                Application.DisplayAlerts = False
                shAct.Delete
                Application.DisplayAlerts = True
            Else
                End
            End If
        End If
    Next shAct

   
End Sub

Sub DetruireScheet(titre As String)
    Dim shAct As Worksheet
    For Each shAct In ActiveWorkbook.Worksheets
        If shAct.Name = titre Then
                Application.DisplayAlerts = False
                shAct.Delete
                Application.DisplayAlerts = True
        End If
    Next shAct
End Sub

Sub CopyImage(nom As String, dest As Range)
    Sheets("Style").Shapes(nom).Copy
    Sheets(nomSheetPalmares).Activate
    dest.Select
    dest.ID = nom
    ActiveSheet.Paste
End Sub


Function ReelEgaux(reel1 As Double, reel2 As Double) As Boolean
   Dim egaux As Boolean
   egaux = False
   
   If Abs(reel1 - reel2) < cEpsilon Then
      egaux = True
   End If
   ReelEgaux = egaux
End Function


Public Function FileFolderExists(strFullPath As String) As Boolean
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Check if a file or folder exists
    On Error GoTo EarlyExit
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
    
EarlyExit:
    On Error GoTo 0
End Function

Sub ClearCollection(ByRef col As Collection)
   If Not (col Is Nothing) Then
    While col.Count > 0
       col.Remove (1)
    Wend
   End If
End Sub

Sub CopyFile(source As String, destination As String)
  Dim fso

  Set fso = CreateObject("Scripting.FileSystemObject")
  fso.CopyFile source, destination

End Sub


Sub BackupFile(sourceFichier As String, destRep As String)

 
  Dim DestinationFichier As String
  Dim now_string As String
  Dim nomFichier As String
  
  now_string = Now
  now_string = Replace(now_string, "/", "_")
  now_string = Replace(now_string, " ", "_")
  now_string = Replace(now_string, ":", "_")

  nomFichier = Replace(Dir(sourceFichier), ".xlsx", "_")
  
  
  DestinationFichier = destRep & "\" & nomFichier & now_string & ".xlsx"

  CopyFile source:=sourceFichier, destination:=DestinationFichier

End Sub

Function checkName(ByVal n As String) As Boolean
  
  Dim ns As Names
  Dim i As Integer
  Set ns = ThisWorkbook.Names
  
  For i = 1 To ns.Count
     If ns(i).Name = n Then
       checkName = True
        Exit Function
     End If
  
  Next i
  checkName = False
End Function


Function StyleEgaux(cells1 As Range, cells2 As Range) As Boolean
   StyleEgaux = False
   
   If cells1.Font.Name = cells1.Font.Name Then
     If cells1.Font.Bold = cells2.Font.Bold Then
         If cells1.Font.Italic = cells2.Font.Italic Then
            If cells1.Font.Size = cells2.Font.Size Then
                If cells1.Font.Strikethrough = cells2.Font.Strikethrough Then
                    If cells1.HorizontalAlignment = cells2.HorizontalAlignment Then
                       StyleEgaux = True
                    End If
                End If
            End If
         End If
     End If
   End If
End Function


Function rechercheStyle(cells As Range) As String

   Dim i As Integer
   
   For i = 1 To Range("Styles").Rows.Count
      If StyleEgaux(cells, Range("Styles").cells(i, 2)) Then
         rechercheStyle = Range("Styles").cells(i, 1)
         GoTo bye
      End If
   Next i
bye:
End Function



